Русская справка по Delphi 5
Мастерская Delphi программирования.
Главная Мастерская Архив Ссылки Отдых Для гостей  
Назад Секреты VCL Секреты API          


unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ExtCtrls, StdCtrls;
const
 wm_BtnClk = wm_User + 111;
type
  TForm1 = class(TForm)
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  R: TRect;
  Press: Boolean;
  procedure WmNcPaint(var Msg: TWmNcPaint); message wm_NcPaint;
  procedure WMNcActivate(var msg: TwmncActivate); message wm_NcActivate;
  procedure WmNcLButtonDown( var Msg: TWMNCLBUTTONDOWN); message Wm_NCLbuttonDown;
  procedure wmnchittest(var Msg: TWMncHITTEST); message wm_NcHittest;
  procedure wmSize(var Msg: TMessage); message wm_Size;
  procedure wmncLButtonUp(var msg: TWMncLBUTTONUP); message wm_NclButtonUp;
  procedure wmLbuttonUp(var Msg: TMessage); message wm_LbuttonUp;
  procedure wmBtnClk(var msg: TMessage); message wm_BtnClk;
  public
    { Public declarations }
    procedure DrawBtn;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}


{ TForm1 }

procedure TForm1.WmNcPaint(var Msg: TWmNcPaint);
begin
 inherited;
 Drawbtn;
end;

procedure TForm1.DrawBtn;
var
  WDc: HDc;
  Cx,Cy: Integer;
  XFrame, Yframe: Integer;
begin
 WDc := GetWindowDc(Handle);
 Cx := GetSystemMetrics(SM_CXSize);
 Cy := GetSystemMetrics(SM_CYSize);
 xFrame := GetSystemMetrics(SM_CXFrame);
 yFrame := GetSystemMetrics(SM_CYFrame);
 R := Bounds(Width - xFrame - 4*Cx + 2, yFrame + 2, Cx - 2, Cy - 4);
 if Press then
  DrawFrameControl(WDc,R,DFC_BUTTON,DFCS_ButtonPUSH or DFCS_PUSHED)
 else
  DrawFrameControl(WDc,R,DFC_BUTTON,DFCS_ButtonPUSH);
 ReleaseDc(Handle,WDC);
end;

procedure TForm1.WMNcActivate(var msg: TwmncActivate);
begin
 inherited;
 DrawBtn;
end;

procedure TForm1.WmNcLButtonDown(var Msg: TWMNCLBUTTONDOWN);
var pt: TPoint;
begin
 inherited;
 drawbtn;
 pt := Point(msg.XCursor - Left,msg.YCursor - top);
 if PtInRect(R,pt) then
 begin
  Press := True;
  drawbtn;
 end;
end;


procedure TForm1.wmnchittest(var Msg: TWMncHITTEST);
var pt: tpoint;
begin
 inherited;
 pt :=Point(msg.XPos - Left, msg.YPos - Top);
 if PtinRect(r,pt) then
  msg.Result := htBorder;
end;

procedure TForm1.wmSize(var Msg: TMessage);
begin
 inherited;
 RedrawWindow(Handle, PRect(0), 0, RDW_FRAME or RDW_NOINTERNALPAINT or RDW_INVALIDATE);
end;

procedure TForm1.wmncLButtonUp(var msg: TWMncLBUTTONUP);
var pt: TPoint;
begin
 inherited;
 pt := Point(msg.XCursor - Left,msg.YCursor - top);
 if PtInRect(R,pt) then
 begin
  Press := False;
  drawbtn;
  PostMessage(Handle,wm_btnClk,0,0);
 end;
end;

procedure TForm1.wmLbuttonUp(var Msg: TMessage);
begin
 inherited;
 if Press then
 begin
  Press := False;
  DrawBtn;
 end;
end;

procedure TForm1.wmBtnClk(var msg: TMessage);
begin
 ShowMessage('***');
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 RedrawWindow(Handle, PRect(0), 0, RDW_FRAME or RDW_NOINTERNALPAINT or RDW_INVALIDATE);
end;

end.

Главная Мастерская Архив Ссылки Отдых Для гостей  
Назад Секреты VCL Секреты API          
Дизайн и программирование - Valler© ,2000,2001.
http://www.valler.narod.ru
Используются технологии uCoz